home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / TILEFORTH / TILE / TILE~ / !Tile / test / hanoi < prev    next >
Text File  |  1992-04-20  |  1KB  |  61 lines
  1. .( Loading Towers of Hanoi benchmark...) cr
  2.  
  3. \ The classical Towers of Hanoi benchmark
  4. \
  5. \ From W.P. Salman, O. Tisserand and B. Toulout, FORTH, Macmillan
  6. \ pp. 120-121
  7.  
  8. variable moves
  9.  
  10. : copy ( x y z -- x y z x y z)
  11.   >r 2dup r@ -rot r>
  12. ;
  13.  
  14. : dispose ( x y z -- )
  15.   2drop drop
  16. ;
  17.  
  18. : edit ( d a n -- d a n)
  19.   copy drop swap ." From: " . ." to: " . cr
  20. ;
  21.  
  22. : prepare-call ( d a n -- d a n d i n-1)
  23.   copy -rot over + 6 swap - rot 1-
  24. ;
  25.  
  26. : prepare-return ( d a n -- d a n i a n-1)
  27.   copy swap rot over + 6 swap - swap rot 1-
  28. ;
  29.  
  30. : verify-hanoi ( departure arrival number -- )
  31.   (event) process
  32.   dup
  33.   if prepare-call recurse
  34.     edit
  35.     prepare-return recurse
  36.   then
  37.   dispose
  38. ;
  39.  
  40. : verify-towers-of-hanoi ( -- )
  41.   1 3 4 verify-hanoi
  42. ;
  43.  
  44. : hanoi ( departure arrival number -- )
  45.   (event) process
  46.   dup
  47.   if prepare-call recurse
  48.     1 moves +!
  49.     prepare-return recurse
  50.   then
  51.   dispose
  52. ;
  53.  
  54. : towers-of-hanoi ( -- )
  55.   0 moves !
  56.   1 3 14 hanoi
  57.   moves @ 16383 = not abort" towers-of-hanoi: wrong result"
  58. ;
  59.  
  60. forth only
  61.